home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / vrmeta / fmvrmeta.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  3KB  |  105 lines
  1. unit Fmvrmeta;
  2.  
  3. interface
  4.  
  5. uses
  6.     SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.     Forms, Dialogs, Menus, ExtCtrls,VRMeta;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     Draw1: TMenuItem;
  13.     Image1: TImage;
  14.     File1: TMenuItem;
  15.     Load1: TMenuItem;
  16.     Circle1: TMenuItem;
  17.     Rectangle1: TMenuItem;
  18.     Create1: TMenuItem;
  19.     Save1: TMenuItem;
  20.     Show1: TMenuItem;
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23.     procedure Create1Click(Sender: TObject);
  24.     procedure Load1Click(Sender: TObject);
  25.     procedure Save1Click(Sender: TObject);
  26.         procedure Circle1Click(Sender: TObject);
  27.     procedure Rectangle1Click(Sender: TObject);
  28.     procedure Show1Click(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.     VrMetafile: TVRMetafile;
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38.  
  39. implementation
  40.  
  41. {$R *.DFM}
  42.  
  43. procedure TForm1.FormCreate(Sender: TObject);
  44. begin { TForm1.FormCreate }
  45.      VrMetafile := TVrMetafile.Create;
  46. end;  { TForm1.FormCreate }
  47.  
  48. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  49. begin { TForm1.FormClose }
  50.      VrMetafile.Free;
  51. end;  { TForm1.FormClose }
  52.  
  53. procedure TForm1.Create1Click(Sender: TObject);
  54. begin { TForm1.Create1Click }
  55.      VrMetafile.Free;
  56.      VrMetafile := TVRMetafile.Create;
  57.      with VRMetafile do
  58.      begin
  59.             Height:=96;
  60.             Width:=96;
  61.             with Canvas    do
  62.             begin
  63.                 Font := Form1.Font;
  64.                 TextOut( 10, 10, 'Hello World');
  65.                 Ellipse( 0, 0, 1000, 1000);
  66.             end;
  67.             {No need to close as we are going to save which will close for us}
  68.             SaveToFile( 'MyWMF.WMF');
  69.  
  70.      end;
  71. end;  { TForm1.Create1Click }
  72.  
  73. procedure TForm1.Load1Click(Sender: TObject);
  74. begin { TForm1.Load1Click }
  75.      VrMetafile.LoadFromFile('MyWmf.wmf');
  76. end;  { TForm1.Load1Click }
  77.  
  78. procedure TForm1.Save1Click(Sender: TObject);
  79. begin { TForm1.Save1Click }
  80.      VrMetafile.SaveToFile( 'MyWMF.WMF');
  81. end;  { TForm1.Save1Click }
  82.  
  83. procedure TForm1.Show1Click(Sender: TObject);
  84. begin { TForm1.Show1Click }
  85.      Image1.Picture.Metafile := VrMetafile;
  86. end;  { TForm1.Show1Click }
  87.  
  88. procedure TForm1.Circle1Click(Sender: TObject);
  89. begin { TForm1.Circle1Click }
  90.      VrMetafile.Canvas.Ellipse(10,10,800,800);
  91.      {no need to close as savetofile will do it for us}
  92.      VrMetafile.SaveToFile( 'MyWMF.WMF');
  93. end;  { TForm1.Circle1Click }
  94.  
  95. procedure TForm1.Rectangle1Click(Sender: TObject);
  96. begin { TForm1.Rectangle1Click }
  97.      VrMetafile.Canvas.Rectangle(50,50,500,500);
  98.      {since were only going to assign we must close first
  99.      ie this doesnt actually acces a VRMeta method first!!!}
  100.      VrMetafile.close;
  101.      Image1.Picture.Metafile := VrMetafile;
  102. end;  { TForm1.Rectangle1Click }
  103.  
  104. end. { Unit FmVrMeta }
  105.